Delphi Programmer's Power Pack/Delphi Volume 1.iso/s_to_z/statone/dynarray.txt

Text File | 1996-09-15 | 6KB | 225 lines

This is code for a dynamic array of Single.

This code does **not** resize the array once you have sized it--there's a procedure to do it that, which  is now empty and a function InitializeArrayValues, that will initialize extra elements when you increase the size of the array (just pass it the pointer to the array and the boundaries of the elements you want to initialize).

The code seems to work, although the testing is not yet extensive.

The code is set up to be easy to convert to other an array of another type. To do so:

 (1) Change the MAX_SIZE constant to an appropriate maximum number for the TYPE you will be using; and

(2) Change the "TElement = Single" line  to "TElement = YourType."

NOTE: you **must** use the range checking in code that reads or writes the Value property or ugly things could happen.

What follows is First, code for the Array object and Second sample code for calling the object.

****************************************************************
THE TRZSingleArray OBJECT CODE:

unit Rzsing3;

interface

uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs;

const
    MAX_SIZE = 16000;

type
    TElement     = Single;
        TIndex         = WORD;
    PElement     = ^TElement;
        TTheArray     = Array[1..MAX_SIZE] of TElement;
        PArray          = ^TTheArray;
        TSingleArray     = class(TComponent)
  private
  { Private declarations }
    FSize:         TIndex;
    FArray:         TTheArray;
             FArrayPtr:     PArray;
        FArrayAssigned: Boolean;
             PROCEDURE     SetArrayValue(idx: TIndex;
                             CONST NewElement: TElement);
             FUNCTION         GetArrayValue(idx: TIndex): TElement;
             PROCEDURE     CreateArray(CONST Size: TIndex);
             PROCEDURE     DestroyArray;
             PROCEDURE     InitializeArrayElements(CONST LoInit, HiInit:TIndex);

  protected
  public
             property    Value[idx: TIndex]: TElement
                    read GetArrayValue
        write SetArrayValue; default;
             property    AddrOfElement[idx: TIndex]: PElement
                 read GetElementAddress;
  published
        property     Size: TIndex
                     read  FSize
                      write FSize;
             FUNCTION    CheckRange(CONST N: TIndex):BOOLEAN;
             FUNCTION     SetSize(Size: TIndex): BOOLEAN;
             constructor Create(AOwner: TComponent); override;
             destructor Destroy; override;
    end;

procedure register;

implementation
{===========================================}
CONSTRUCTOR TSingleArray.Create(AOwner: TComponent);
    BEGIN
            inherited Create(AOwner);
                 TRY      IF FSize > 0
                            THEN     CreateArray(Size)
                             ELSE    FArrayAssigned := FALSE;
                         FSize := 0;
                      FINALLY inherited Destroy;
                         END;
            END;

DESTRUCTOR TSingleArray.Destroy;
    BEGIN
        DestroyArray;
                 inherited Destroy;
        END;

PROCEDURE TSingleArray.InitializeArrayElements
            (CONST LoInit, HiInit: TIndex);
    VAR
        idx: TIndex;
    BEGIN
        FOR     idx := LoInit TO HiInit
                     DO FArrayPtr^[idx] := 0.0;
            END;

PROCEDURE TSingleArray.CreateArray(CONST Size: TIndex);
    BEGIN
        GetMem(FArrayPtr, Size * SizeOf(TElement));
                 FSize := Size;
                 InitializeArrayElements(1, FSize);
                 FArrayAssigned := TRUE
            END;

PROCEDURE TSingleArray.DestroyArray;
    BEGIN
        FreeMem(FArrayPtr, FSize * SizeOf(TElement));
                 FArrayAssigned := FALSE;
            END;

FUNCTION TSingleArray.CheckRange(CONST N: TIndex): BOOLEAN;
    BEGIN
                IF     (N > FSize) OR (N < 1)
                     THEN Result := FALSE
                      ELSE Result := TRUE;
                END;

PROCEDURE TSingleArray.SetArrayValue(idx: TIndex;
    CONST NewElement: TElement);
    BEGIN
        FArray[idx] := NewElement;
            END;

FUNCTION TSingleArray.GetArrayValue(idx: TIndex): TElement;
        BEGIN
            Result := FArray[idx];
            END;

FUNCTION TSingleArray.SetSize(Size: TIndex): BOOLEAN;

    {CHECK THE RANGE
              =================================================================}
            IF     (Size > MAX_SIZE) OR (Size < 1)
                 THEN BEGIN     Result := FALSE;
                          Exit;
                                     END;

             {CHECK TO SEE IF USER IS CHANGING SIZE
              ==================================================================}
        IF Size = FSize
                 THEN Exit;

             {SET THE SIZE
              ==================================================================}
             IF     FArrayAssigned = FALSE
                  THEN    CreateArray(Size)
                  ELSE {REALLOCATE ARRAY ROUTINE HERE};
             END;

PROCEDURE Register;
    BEGIN
        RegisterComponents('Samples', [TSingleArray]);
         END;

end.


*********************************************
CODE FOR A FORM THAT CALLS TSingleArray

unit Arryfrm3;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, rzsing3;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  TestArray: TSingleArray;

implementation

TYPE
    PSingle = ^Single;

{$R *.DFM}

PROCEDURE TForm1.Button1Click(Sender: TObject);
    BEGIN
        TestArray := TSingleArray.Create(Self);
                 Edit1.Text := inttostr(TestArray.Size);
        {Shows the size of the array at initialization. Should be 0}
        END;
                 IF NOT (TestArray.SetSize(27) = TRUE)
                     THEN {RAISE EXCEPTION HERE};
        IF TestArray.CheckRange(25) = TRUE
            THEN TestArray[25] := 24.5;
        IF TestArray.CheckRange(25) = TRUE
            THEN     Edit2.Text := FloatToStr(TestArray[25]);
        {Shows the value I just placed in element 25. Should be 24.5}
                 TestArray.Free;
        END;

PROCEDURE TForm1.Button2Click(Sender: TObject);
    BEGIN
        TestArray := TSingleArray.Create(Self);
                 Edit1.Text := inttostr(TestArray.Size);
        END;

end.

Use this however you want.

Frank Francone